perm filename PASTE.SAI[PIX,HPM] blob sn#467729 filedate 1979-08-17 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PASTE"
C00005 ENDMK
C⊗;
BEGIN "PASTE"
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
INTEGER ARRAY XP,YP[1:100], IHD[1:100,0:10], IC[1:100], OHD[0:10]; INTEGER OC;
INTEGER ARRAY OLIST[1:17],OBUF[-1:120]; INTEGER OL;
STRING ARRAY FN[1:100];
INTEGER NF,FOO,I,J,K,L,NXT; STRING S;
INTEGER T,OH,OW; REAL UNITS;

PRINT("Units (pixel, in, cm):"); T←(INCHWL LAND '137);
UNITS←1;
IF T="P" THEN UNITS←1 ELSE
IF T="I" THEN UNITS←200 ELSE
IF T="C" THEN UNITS←78.74 ELSE PRINT("pixels",'15&'12);

NF←0;
WHILE TRUE DO
   BEGIN "FILE NAMES"
   NF←NF+1;
   PRSFIL("");
   DO
     BEGIN
     PRINT("Upleft corner, file ",NF," (Y X FILE):"); S←INCHWL;
     IF LENGTH(S)=0 THEN BEGIN NF←NF-1; DONE "FILE NAMES"; END;
     YP[NF]←REALSCAN(S,FOO)*UNITS; XP[NF]←REALSCAN(S,FOO)*UNITS;
     FN[NF]←S[2 TO ∞];
     END
   UNTIL PFLDIM(FN[NF])>0;
   END "FILE NAMES";

FOR I←2 STEP 1 UNTIL NF DO
FOR J←1 STEP 1 UNTIL I-1 DO
IF YP[J]>YP[I] THEN BEGIN FN[I]↔FN[J]; YP[I]↔YP[J]; XP[I]↔XP[J]; END;

PRINT("Output picture dimensions (Height, width):"); S←INCHWL;
OH←REALSCAN(S,FOO)*UNITS; OW←REALSCAN(S,FOO)*UNITS;
MAKDIM(OH,36+OW,1,OHD[0]);
PRSFIL(""); PRINT("Output file:"); OC←CREPFL(OHD[0],INCHWL);

NXT←1; OL←0;
FOR I←0 STEP 1 UNTIL OHD[PCLN]-1 DO
   BEGIN
   ARRCLR(OBUF);
   WHILE NXT≤NF ∧ YP[NXT]=I DO
      BEGIN
      OLIST[OL←OL+1]←NXT;
      PRSFIL("");
      IC[NXT]←OPNPFL(FN[NXT],IHD[NXT,0]);
      NXT←NXT+1;
      END;
   FOR K←1 STEP 1 UNTIL OL DO
   IF YP[OLIST[K]]+IHD[OLIST[K],PCLN] = I THEN
      BEGIN
      PFLCLS(IC[OLIST[K]]);
      OLIST[K]←OLIST[OL];
      K←K-1;
      OL←OL-1;
      END
   ELSE
      PFLIN(IC[OLIST[K]],OBUF[XP[OLIST[K]]%36],IHD[OLIST[K],LNWD]);
   PFLOUT(OC,OBUF[-1],OHD[LNWD]);
   END;
PFLCLS(OC);

END "PASTE";